home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 001_100 / disk0074 / demo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1983-08-29  |  36.9 KB  |  1,131 lines
  1.  
  2. {This sample program is a menu driven  demo program for the Pascal Utilities 2.1
  3.  It demostrates background music, pie, bar, line charts and animation.
  4.  It can also be used to test individual routines with  user supplied
  5.  parameters.
  6. (C)Copyright Software Labs. 1052 Lily Ave. Sunnyvale, CA 94086. (408)-241-9539.}
  7. { demog - a pascal unit to demostrate graphics and music }
  8. { demos - a pascal unit to display all the text color table }
  9. {$include:'b:demog.inc'}
  10. {$include:'b:demos.inc'}
  11. program demo( input, output );
  12. uses demogunit( demog );
  13. uses demosunit( demosall, demos );
  14.  
  15. {The following include files contains the declarations for external functions
  16.  which are written in 8088 Macro Assembly Language.}
  17. {$include:'b:slib.inc'}      {Screen control routines }
  18. {$include:'b:glib.inc'}      {Graphics routines }
  19. {$include:'b:alib.inc'}      {Animation routines }
  20. {$include:'b:plib.inc'}      {Music and periperal control routines }
  21. {$debug-}
  22. procedure time( var s: string ); extern;   { IBM PASCAL function }
  23.  
  24. const
  25.  msgcol = 0; msgrow =23;     { col & row for displaying prompt message }
  26.  inforow = 22;            { row number for displaying returned information}
  27.  displayrow = 0;                    { display time and mode }
  28.  softsize = 10;           { number of characters displayed in a softkey }
  29.  { attribute for the IBM monochrome screen display  }
  30.  normal = 2; intensity = 15; reverse=120;
  31.  blinking = 128+normal    ;  rblink = reverse+128;     { reverse blinking }
  32.  lastmode = 8;
  33.  
  34.  { scan code for characters}
  35.  scanf0 = 58; scanf10 = scanf0+10;         { scan code for F1 - 1 and F10 }
  36.  qesc = 1; {ESC exit }
  37.  
  38.  homecol = 33; homerow = 13;                { home row & column }
  39.  
  40.  { constant for display softkeys }
  41.  keyrow = 1; keyrowdiff =  2; keysecondcol =11; keystartcol = 0;
  42.  blanks = '                                        ';
  43.  initialdelay = 300;        {initial delay }
  44.  
  45. type
  46.   softkeytype = array[ 1 .. 10 ] of lstring(softsize);{ labels for 10 softkeys}
  47.   timetype = string(8);         { for calling the time function }
  48.  
  49. var
  50.   modes[static] : softkeytype;           { message for screen mode 0 to 7 }
  51.   rcolor[static] : array[0..7] of integer; { blinking color for screen modes}
  52.   rbcolor[static] : array[0..7] of integer; {reverse blinking for screen modes}
  53.   displayedtime : timetype;           { displayed time on the screen }
  54.   currentrow, currentcol, currentpage, currentstart, currentstop, currentmode,
  55.   lastscan : integer;
  56.   lastch : char;
  57.  
  58. value
  59.   { modes  - used as the prompt message when the user wants to execute
  60.          screen or screeng procedure.
  61.     rcolor - used to display reverse video message for different screen modes.
  62.     rbcolor- used to display rever and blinking message for screen modes. }
  63.   modes[ 1 ] := '0:40x25 BW';  rcolor[ 0 ] := reverse;  rbcolor[ 0 ] := rblink;
  64.   modes[ 2 ] := '1:40x25 C ';  rcolor[ 1 ] := reverse;  rbcolor[ 1 ] := rblink;
  65.   modes[ 3 ] := '2:80x25 BW';  rcolor[ 2 ] := reverse;  rbcolor[ 2 ] := rblink;
  66.   modes[ 4 ] := '3:80x25 C ';  rcolor[ 3 ] := reverse;  rbcolor[ 3 ] := rblink;
  67.   modes[ 5 ] := '4:320x200C';  rcolor[ 4 ] := normal;   rbcolor[ 4 ] := 1;
  68.   modes[ 6 ] := '5:320x200B';  rcolor[ 5 ] := normal;   rbcolor[ 5 ] := 1;
  69.   modes[ 7 ] := '6:640x200B';  rcolor[ 6 ] := normal;   rbcolor[ 6 ] := 1;
  70.   modes[ 8 ] := '7:80x25 BW';  rcolor[ 7 ] := reverse;  rbcolor[ 7 ] := rblink;
  71.  
  72.  
  73.  
  74.  
  75. {***** lstringwrite - write lstring at specified position }
  76. procedure lstringwrite( page, row, col, attribute: integer; const ls:lstring);
  77. begin
  78.   locate( page, row, col );
  79.   putlstring( page, attribute, ls );
  80. end;  {lstringwrite}
  81.  
  82.  
  83.  
  84.  
  85. {*****copyright -  print copyright message }
  86. procedure copyright;
  87. begin
  88.  lstringwrite(currentpage, 24, 6, intensity,'(C) Copyright Software Labs 1983');
  89. end; {copyright}
  90.  
  91.  
  92.  
  93. {*****pressreturn - wait until any key is pressed }
  94. procedure pressreturn;
  95. begin
  96.   lstringwrite(currentpage,msgrow, msgcol, intensity, 'Press any key to exit');
  97.   while not inkey( lastch, lastscan ) do { do nothing } ;
  98. end; { pressreturn }
  99.  
  100.  
  101.  
  102.  
  103. {*****pressclear - wait until any key is pressed then clear the screen }
  104. procedure pressclear;
  105. begin
  106.   pressreturn;
  107.   screen ( currentmode);      { clear the screen }
  108. end; { pressreturn }
  109.  
  110.  
  111.  
  112.  
  113. {****** blankmessage - blank the message line and the information line }
  114. procedure blankmessage;
  115. begin
  116.   lstringwrite(currentpage,msgrow,msgcol,normal,blanks);
  117.   lstringwrite(currentpage,inforow,msgcol,normal,blanks);
  118.   locate(currentpage, currentrow, currentcol);
  119. end; { blankmessage }
  120.  
  121.  
  122.  
  123.  
  124. {***** arraymessage - display messages in array format (2 columns) }
  125. { the left column start from column: startcolumn; right column from secondcol}
  126. procedure arraymessage(const msg : softkeytype; last, page, startrow,
  127.     startcol, secondcol, rowdiff,  attribute : integer);
  128. var
  129.   row, i : integer;
  130. begin
  131.   i := 1;  row := startrow;
  132.   while i < last do begin
  133.     locate(page, row, startcol);
  134.     putlstring(page,  attribute, msg[i] );          { left column message}
  135.     i := i +1;
  136.     if i > last then break                  { out of loop }
  137.     else begin
  138.       locate(page, row, secondcol);
  139.       putlstring( page, attribute, msg[i] );           {right column message}
  140.       row := row + rowdiff;
  141.       i := i +1
  142.     end;
  143.   end;
  144. end; { arraymessage }
  145.  
  146.  
  147.  
  148.  
  149. {***** displaytime - display current time on the top line }
  150. { The time interval between displaytime is very short, the redisplaying line
  151.   on the screen is flashing. To avoid that, we will redisplay time only if
  152.   it is different from the previously  displayed time}
  153.  procedure displaytime;
  154.  var
  155.    currenttime : timetype;
  156.  begin
  157.   time( currenttime );
  158.   if currenttime <> displayedtime then      { displayedtime is a global          }
  159.   begin                   {variable storing the displayed time}
  160.      locate(currentpage, displayrow, 0);
  161.      putstring(currentpage, normal, 8, currenttime);
  162.      locate( currentpage, currentrow, currentcol);
  163.      movel(adr currenttime[1], adr displayedtime[1], 8);  {update displayedtime}
  164.   end;
  165. end; { displaytime }
  166.  
  167.  
  168.  
  169.  
  170. {***** displaymode - display screen mode on the right most of the top line }
  171. procedure displaymode;
  172. var key : integer;
  173. begin
  174.   locate(currentpage, displayrow, 39);
  175.   putchar( currentpage, normal, 1, chr(currentmode+ord('0')) );
  176. end; { displaymode }
  177.  
  178.  
  179.  
  180.  
  181. {****** concatvalue- attach an integer value to an lstring }
  182. procedure concatvalue( var ls : lstring; dvalue, size : integer);
  183. var
  184.   svalue : lstring(10);
  185. begin
  186.   eval( encode( svalue, dvalue:size));    { convert dvalue into lstring(svalue)}
  187.   concat( ls, svalue);
  188. end; { concatvalue }
  189.  
  190.  
  191.  
  192.  
  193. {***** displaycursor - display cursor information }
  194. { prepare a printing buffer for the cursor with the following information: }
  195. { (page,row,col) [start..stop]                 }
  196. procedure displaycursor;
  197. var
  198.   ls : lstring(80);
  199. begin
  200.   ls := ' (';
  201.   concatvalue(ls, currentpage, 1);  concat(ls, ',');              { page   }
  202.   concatvalue(ls, currentrow  ,2);  concat(ls, ',');              { row    }
  203.   concatvalue(ls, currentcol  ,2);  concat(ls, ') [');            { column }
  204.   concatvalue(ls, currentstart,2);  concat(ls, '..');             { start  }
  205.   concatvalue(ls, currentstop ,3);  concat(ls, '] ');             { stop   }
  206.   lstringwrite(currentpage,  displayrow, 8, normal, ls);
  207. end; { displaycursor }
  208.  
  209.  
  210.  
  211.  
  212. {***** displaych - display the last character }
  213. { prepare a printing buffer for the character with the following format }
  214. { ord: chr : scan }
  215. procedure displaych;
  216. var  string1 : string(1);
  217.   ls : lstring(80);
  218. begin
  219.   ls := ' ';
  220.   string1[1] :=  lastch;
  221.   concat(ls, string1);           concat(ls, ':');
  222.   concatvalue(ls, ord(lastch),3);   concat(ls, ':');
  223.   concatvalue(ls, lastscan,3);
  224.   lstringwrite(currentpage, displayrow, 28,  normal, ls);
  225. end; { displaych }
  226.  
  227.  
  228.  
  229.  
  230. {***** messageuse - displaying a message on the screen }
  231. procedure messageuse;
  232. begin
  233.   lstringwrite(currentpage, msgrow, msgcol,  intensity,
  234.     'Press F1..F10 (selction) or ESC (exit)  ');
  235.   locate(currentpage, currentrow, currentcol);
  236. end; { messageuse }
  237.  
  238.  
  239.  
  240.  
  241. {***** newdisplay - display 10 softkeys, and the current time }
  242. procedure newdisplay(const message: softkeytype);
  243. var
  244.   numcolumn : integer;
  245. begin
  246.   currentmode := screenmode( currentpage, numcolumn);
  247.   screen(currentmode);
  248.   copyright;
  249.   arraymessage( message, softsize, currentpage, keyrow, keystartcol,
  250.     keysecondcol, keyrowdiff, rcolor[currentmode]);
  251.   messageuse;                   { 'use function keys' message }
  252.   displaytime;
  253. end; { newdisplay }
  254.  
  255.  
  256.  
  257.  
  258. {***** blinkkey - blink the position of the pressed function key }
  259. procedure blinkkey( msg : softkeytype; key : integer; var blinkrow,
  260.     blinkcol : integer);
  261. begin
  262.   { find the location (row, left or right column)  of the pressed key }
  263.   blinkrow := keyrow + ((key-1) div 2 ) * keyrowdiff;
  264.   if ( key mod 2 ) = 1 then
  265.     blinkcol := keystartcol
  266.   else
  267.     blinkcol := keysecondcol;
  268.   lstringwrite(currentpage, blinkrow, blinkcol, rbcolor[currentmode],
  269.        msg[key]);
  270. end; { blinkkey }
  271.  
  272.  
  273.  
  274.  
  275. {***** cursormoves - routines responsed for moving the cursor }
  276. procedure cursormoves( scan : integer );
  277. const
  278.  qhome = 71;    { home }
  279.  qup   = 72;    { up arrow in the number pad }
  280.  qleft = 75;  qright= 77; qdown = 80;
  281. begin
  282.   case scan of
  283.    qup     : currentrow := currentrow-1;
  284.    qdown : currentrow := currentrow+1;
  285.    qleft : currentcol := currentcol -1;
  286.    qright: currentcol := currentcol + 1;
  287.    qhome : begin  currentrow := homerow; currentcol := homecol; end;
  288.    otherwise { do nothing }
  289.   end;
  290.   locate( currentpage, currentrow, currentcol);
  291.   readcursor(currentpage, currentrow, currentcol, currentstart, currentstop);
  292.   displaycursor;
  293.   locate( currentpage, currentrow, currentcol);
  294. end; { cursormoves }
  295.  
  296.  
  297.  
  298.  
  299. {***** getint - ask the user to type an integer from the keyboard }
  300. function getint( const msg : lstring ): integer;
  301. label 1;
  302. var
  303.   msgbuffer,ls : lstring(80); i : integer;
  304. begin
  305.   { print the prompt message }
  306.   msgbuffer := 'Enter > ';
  307.   insert(msg, msgbuffer, 7);          { IBM routines to insert msg into
  308.                        msgbuffer just befor the 7th character}
  309. 1:lstringwrite(currentpage, msgrow, msgcol, intensity, msgbuffer);
  310.   readln(ls);
  311.   if ord(ls[0]) = 0 then      { carrige return returns zero length string }
  312.     getint := 0
  313.   else
  314.     if decode( ls, i ) then           { convert ls into an integer sucessful}
  315.       getint := i
  316.     else begin                         { decode failed }
  317.       lstringwrite(currentpage, msgrow, msgcol, normal, blanks); { erase it }
  318.       goto 1;                        { ask again  }
  319.     end;
  320.   lstringwrite(currentpage, msgrow, msgcol, normal, blanks); { erase it }
  321. end; { getint }
  322.  
  323.  
  324.  
  325.  
  326. {***** getstring - get a string }
  327. procedure getstring(const msg : lstring; var ls : lstring);
  328. var  msgbuffer : lstring(80);
  329. begin
  330.   msgbuffer := 'Enter > ';
  331.   insert(msg, msgbuffer, 7);                   { IBM routine }
  332.   lstringwrite(currentpage, msgrow, msgcol, intensity, msgbuffer);
  333.   readln(ls);
  334.   lstringwrite(currentpage, msgrow, msgcol, normal, blanks);   { erase it }
  335. end; {getstring}
  336.  
  337.  
  338.  
  339.  
  340. {***** askpage - ask the user to type the page number from the keyboard}
  341. function askpage : integer;
  342. begin
  343.   if currentmode >=  4 then
  344.     askpage := getint('page(0..0)')
  345.   else if currentmode >= 2 then
  346.     askpage := getint('page(0..3)')
  347.     else
  348.       askpage := getint('page(0..7)');
  349. end; {askpage}
  350.  
  351.  
  352.  
  353.  
  354. {***** screen1routines - routines for handling screen routines }
  355. procedure screen1routines;
  356. const
  357.  { screen keys }
  358.   qscreen    = 1;     qputchar   = 2;
  359.   qreadcursor= 3;     qputstring = 4;
  360.   qlocate    = 5;     qputlstring= 6;
  361.   qscroll    = 7;     qscreenchar= 8;
  362.   qselectpage= 9;     qexit        =10;
  363.  
  364. var
  365.   ls : lstring(80);  page, color, i, scancode,ulrow, lrcol,lrrow,
  366.   blinkcol, blinkrow, column, mode, key : integer;
  367.   screen1 [static] : softkeytype;   ch : char;
  368.  
  369. value
  370.   screen1[ qscreen    ] := 'SCREEN    ';  screen1[ qputchar   ] := 'PUTCHAR   ';
  371.   screen1[ qreadcursor] := 'READCURSOR';  screen1[ qputstring ] := 'PUTSTRING ';
  372.   screen1[ qlocate    ] := 'LOCATE    ';  screen1[ qputlstring] := 'PUTLSTRING';
  373.   screen1[ qscroll    ] := 'SCROLL    ';  screen1[ qscreenchar] := 'SCREENCHAR';
  374.   screen1[ qselectpage] := 'SELECTPAGE';  screen1[ qexit      ] := 'EXIT      ';
  375.  
  376. begin
  377.   newdisplay( screen1 );        { display softkey on the screen }
  378.   displaycursor;            { cursor position and shape }
  379.   displaych;                { last pressed character    }
  380.   displaymode;                { screen mode }
  381.   messageuse;
  382.   repeat                { until the user pressed ESC }
  383.    while not inkey( lastch, lastscan ) do { while no key is pressed }
  384.      displaytime;            { update the displayed time on the screen}
  385.    displaych;
  386.    if lastscan = qesc then break;    { exit }
  387.    if lastscan = scanf10 then break;
  388.    if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
  389.      key := lastscan - scanf0;
  390.      blinkkey(screen1, key, blinkrow, blinkcol );   { blinking the pressed key}
  391.      blankmessage;                    { blank message lines }
  392.      case key  of
  393.       qscreen :
  394.          begin
  395.         if currentmode = 7 then
  396.           mode := getint('mode (7..7)')
  397.         else begin
  398.           { print screen information by using the modes array}
  399.           arraymessage(modes,7,currentpage,17,2,15,1,normal);
  400.           mode := getint('mode (0..6)')
  401.         end;
  402.           { the seting to mode 7 for non Monochrome adapter will have
  403.              snow flashing }
  404.         if ( mode = 7 ) and ( currentmode <> 7 ) then begin
  405.           lstringwrite(currentpage,msgrow, msgcol, normal,
  406.         ' Only Monochrome and Parallel Printer Adapter can use Mode 7');
  407.           pressreturn;
  408.         end
  409.         else begin
  410.           screen( mode );
  411.           currentmode := screenmode( currentpage, column);
  412.           newdisplay( screen1 );
  413.         end;
  414.           end;
  415.  
  416.       qscreenchar : begin
  417.         page := askpage;
  418.         locate(page, currentrow, currentcol);
  419.         ch := screenchar(page, color);
  420.         locate(currentpage, inforow, msgcol);
  421.         writeln('SCREENCHAR=',ch  ,' attribute=',color:1,
  422.             ' ord(SCREENCHAR)=', ord(ch):1);
  423.           end;
  424.  
  425.       qputchar : begin
  426.         page := askpage;
  427.         color := getint('color (0..255)');
  428.         { if the user type ENTER, or carriage return, then ask for
  429.           the scan code input }
  430.         getstring('character(ENTER for scan code)',ls);
  431.         if ls[0] = chr(0) then begin      { ENTER }
  432.           { scan code input }
  433.           repeat
  434.             scancode := getint('scan code (0..255)');
  435.           until ( scancode >= 0 ) and ( scancode <= 255);
  436.           ch := chr( scancode );
  437.         end
  438.         else
  439.           ch := ls[1];
  440.         i := getint('count');
  441.         locate(page, currentrow, currentcol);
  442.         putchar(page,color,i,ch);
  443.         readcursor(currentpage, currentrow, currentcol, currentstart,
  444.             currentstop);         { update the cursor position}
  445.           end; { qputchar }
  446.  
  447.       qputstring : begin
  448.         page := askpage;
  449.         color := getint('color (0..255)');
  450.         getstring('string',ls);
  451.         i := getint('length');
  452.         locate(page, currentrow, currentcol);
  453.         putstring(page, color, i, ls[1]);
  454.         readcursor(currentpage, currentrow, currentcol, currentstart,
  455.             currentstop);         { update the cursor position}
  456.           end;
  457.  
  458.       qputlstring : begin
  459.         page := askpage;
  460.         color := getint('color (0..255)');
  461.         getstring('string',ls);
  462.         locate(page, currentrow, currentcol );
  463.         putlstring(page, color, ls);
  464.         readcursor(currentpage, currentrow, currentcol, currentstart,
  465.             currentstop);         { update the cursor position}
  466.           end;
  467.  
  468.       qselectpage : begin
  469.         page := askpage;
  470.         selectpage(currentpage);
  471.         newdisplay( screen1);
  472.           end;
  473.  
  474.       qscroll : begin
  475.         getstring('Up/Down',ls);
  476.         i := getint('numline(0..24), 0:entire window');
  477.         ulrow  := getint('ulrow');
  478.         column := getint('ulcol');
  479.         lrrow  := getint('lrrow');
  480.         lrcol  := getint('lrcol');
  481.         color  := getint('background color');
  482.         scroll(ls[1], i, ulrow, column, lrrow, lrcol, color);
  483.           end;
  484.  
  485.       qreadcursor  : begin
  486.         page := askpage;
  487.         locate(page, currentrow, currentcol );
  488.         readcursor(page, currentrow, currentcol, currentstart,
  489.             currentstop);         { update the cursor position}
  490.         locate(currentpage, inforow, msgcol);
  491.         writeln('row=',currentrow:1, ' col=', currentcol:1,' start=',
  492.             currentstart:1, ' stop=',currentstop:1);
  493.           end;
  494.  
  495.       qlocate : begin
  496.         page := askpage;
  497.         lrrow  := getint('row number (0..24)');
  498.         mode := screenmode(currentpage, column);
  499.         if column = 80 then
  500.           lrcol  := getint('column number (0..79)')
  501.         else
  502.           lrcol  := getint('column number (0..39)');
  503.         locate(page, lrrow, lrcol);
  504.         readcursor(currentpage, currentrow, currentcol, currentstart,
  505.             currentstop);         { update the cursor position}
  506.           end;
  507.  
  508.  
  509.       otherwise { do nothing }
  510.       end; { case }
  511.      lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
  512.      , screen1[key]);      { reset the blinking function key to reverse }
  513.      lstringwrite(currentpage,msgrow,msgcol,normal,blanks);
  514.      messageuse;
  515.      end  { if lastscan > scanf0 and lastscan <= scanf10 }
  516.     else
  517.       cursormoves( lastscan );
  518.    until false;     { repeat until ESC is pressed }
  519. end; {screen1routines}
  520.  
  521.  
  522.  
  523.  
  524. {***** screen2routines - routines for handling screen routines }
  525. procedure screen2routines;
  526. const
  527.  { screen keys }
  528.   qmono      = 1;     qnewcursor = 2;
  529.   qmonitorc  = 3;     qreadcursor= 4;
  530.   qborder    = 5;     qscreenmode= 6;
  531.   qinkey     = 7;     qexit        = 10;
  532.  
  533.  var
  534.   page, row, col, x, y, blinkcol, blinkrow, numcolumn, key, color : integer;
  535.   screen2 [static] : softkeytype;
  536.  
  537. value
  538.   screen2[ qmono      ] := 'MONO      ';  screen2[ qnewcursor ] := 'NEWCURSOR ';
  539.   screen2[ qmonitorc  ] := 'MONITORC  ';  screen2[ qreadcursor] := 'READCURSOR';
  540.   screen2[ qborder    ] := 'BORDER    ';  screen2[ qscreenmode] := 'SCREENMODE';
  541.   screen2[ qinkey     ] := 'INKEY     ';  screen2[ 8          ] := '          ';
  542.   screen2[ 9          ] := '          ';  screen2[ qexit      ] := 'EXIT      ';
  543.  
  544.  begin
  545.   newdisplay( screen2 );        { display softkey on the screen }
  546.   displaycursor;            { cursor position and shape }
  547.   displaych;                { last pressed character    }
  548.   displaymode;                { screen mode }
  549.   messageuse;
  550.   repeat                { until the user pressed ESC }
  551.    while not inkey( lastch, lastscan ) do   { while no key is pressed }
  552.      displaytime;            { update time display }
  553.    displaych;
  554.    if lastscan = qesc then break;    { exit }
  555.    if lastscan = scanf10 then break;
  556.    if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
  557.      key := lastscan - scanf0;
  558.      blinkkey(screen2, key, blinkrow, blinkcol );   { blinking the pressed key}
  559.      blankmessage;                    { blank message lines }
  560.      case key  of
  561.       qmono   : begin
  562.         mono;           { switch to the mono monitor }
  563.         currentmode := screenmode( currentpage, numcolumn);
  564.         newdisplay( screen2);
  565.           end;
  566.  
  567.       qmonitorc:  begin
  568.         monitorc;     { switch to the color monitor }
  569.         currentmode := screenmode( currentpage, numcolumn);
  570.         newdisplay( screen2 );
  571.           end;
  572.  
  573.       qreadcursor  : begin
  574.         page := askpage;
  575.         locate(currentpage, currentrow, currentcol);
  576.         readcursor(page, currentrow, currentcol, currentstart,
  577.             currentstop);         { update the cursor position}
  578.         locate(currentpage, inforow, msgcol);
  579.         writeln('row=',currentrow:1, ' col=', currentcol:1,' start=',
  580.             currentstart:1, ' stop=',currentstop:1);
  581.           end;
  582.  
  583.       qnewcursor  : begin
  584.         currentstart  := getint('start line(0..32)32:invisible');
  585.         currentstop   := getint('stop line(0..31)');
  586.         locate(currentpage, currentrow, currentcol);
  587.         newcursor( currentstart, currentstop);
  588.         readcursor(currentpage, currentrow, currentcol, currentstart,
  589.             currentstop);         { update the cursor position}
  590.         displaycursor;
  591.           end;
  592.  
  593.       qscreenmode : begin
  594.         currentmode := screenmode( currentpage, numcolumn);
  595.         locate(currentpage, inforow, msgcol);
  596.         writeln('SCREENMODE=',currentmode:1, ' page=', currentpage:1,
  597.             ' numcolumn=', numcolumn:1);
  598.           end;
  599.  
  600.       qinkey : begin
  601.         lstringwrite(currentpage, msgrow, msgcol,normal,
  602.             'Press any key to continue');
  603.         while not inkey( lastch, lastscan ) do{ while no key is pressed}
  604.           displaytime;             { update time display }
  605.         displaych;
  606.         locate(currentpage, inforow, msgcol);
  607.         writeln('INKEY=TRUE ch=', lastch,' scan=',lastscan:1,' ord(ch)=',
  608.                 ord(lastch):1);
  609.           end;
  610.  
  611.       qborder : begin
  612.         color := getint('border color (0..31)');
  613.         border( color);
  614.           end;
  615.  
  616.       otherwise { do nothing }
  617.       end; { case }
  618.      lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
  619.      , screen2[key]);      { reset the blinking function key to reverse }
  620.      lstringwrite(currentpage,msgrow,msgcol,normal,blanks);
  621.      messageuse;
  622.      end  { if lastscan > scanf0 and lastscan <= scanf10 }
  623.     else
  624.       cursormoves( lastscan );
  625.    until false;     { repeat until ESC is pressed }
  626. end; {screen2routines}
  627.  
  628.  
  629.  
  630.  
  631.  
  632. {***** graphicsroutines - handle graphics routines }
  633. procedure graphicsroutines;
  634. const
  635.  { graphics keys }
  636.   qpalette    = 1;   qpaint    = 2;
  637.   qreaddot    = 3;   qgetpic   = 4;
  638.   qwritedot   = 5;   qputpic   = 6;
  639.   qdrawline   = 7;   qview     = 8;
  640.   qcircle     = 9;   qlightpen =10;
  641.   picsize = 260;      { for getpic & putpic }
  642.  
  643. var
  644.   blinkcol, blinkrow,sangle, eangle, width, height, x2, y2, mode, page, numcolumn,
  645.   i, x, y, col, row, bcolor, fcolor, action, palettenum, key : integer;
  646.   pic : string(picsize);     {storing picture for getpic and putpic }
  647.   graphics [static] : softkeytype;
  648.  
  649. value
  650.   graphics[ qpalette   ] := 'PALETTE   ';
  651.   graphics[ qreaddot   ] := 'READDOT   ';
  652.   graphics[ qwritedot  ] := 'WRITEDOT  ';
  653.   graphics[ qdrawline  ] := 'DRAWLINE  ';
  654.   graphics[ qcircle    ] := 'CIRCLE    ';
  655.   graphics[ qgetpic    ] := 'GETPIC    ';
  656.   graphics[ qputpic    ] := 'PUTPIC    ';
  657.   graphics[ qpaint     ] := 'PAINT     ';
  658.   graphics[ qview      ] := 'VIEW      ';
  659.   graphics[ qlightpen  ] := 'LIGHTPEN  ';
  660.  
  661.  
  662.  
  663.    {***** askcolor - ask color from the user depending the palette number}
  664.    function askcolor:integer;
  665.    begin
  666.        if palettenum = 0 then
  667.      askcolor := getint('color (1:G;2:R;3:Y)')
  668.        else
  669.      askcolor := getint('color (1:C;2:M;3:W)');
  670.    end;  {askcolor}
  671.  
  672.  
  673.  
  674.    {***** askx - ask x-coordinate from the user depending on the mode }
  675.     function askx : integer;
  676.     begin
  677.        if currentmode = 6 then
  678.      askx := getint('x coordinate (0..639)')
  679.        else
  680.      askx := getint('x coordinate (0..319)');
  681.     end;  {askx}
  682.  
  683.  
  684.  
  685. begin
  686.   { change it to graphics mode 4 if possible }
  687.   currentmode := screenmode(page, numcolumn);
  688.   if ( currentmode = 7 ) then begin      { monochrome card }
  689.     lstringwrite(currentpage, inforow,msgcol, normal,
  690.     ' There is no Color/Graphics Adapter');
  691.     pressclear;
  692.   end
  693.   else
  694.     if currentmode <> 4 then begin
  695.       screen(currentmode);
  696.       lstringwrite(currentpage, inforow, msgcol, normal,
  697.      'Screen will be set to mode 4 (320x200 color)');
  698.       currentmode := 4;
  699.       pressclear;
  700.     end;
  701.   currentmode := screenmode(page, numcolumn);
  702.   newdisplay( graphics );    { display softkeys }
  703.   palette(0, 1);         { use palette 0; blue backgound }
  704.   { print different color on the screen }
  705.   if currentmode = 4 then begin
  706.     lstringwrite(currentpage, 21,  0, 1, 'Color 1');
  707.     lstringwrite(currentpage, 21, 10, 2, 'Color 2');
  708.     lstringwrite(currentpage, 21, 20, 3, 'Color 3');
  709.   end;
  710.   messageuse;
  711.   repeat
  712.    while not inkey( lastch, lastscan ) do
  713.      displaytime;
  714.    if (lastscan = 0 ) and ( lastch = chr(0) ) then break;
  715.    if lastscan = qesc then break;        { out of the repeat loop }
  716.    if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
  717.      key := lastscan - scanf0;
  718.      blankmessage;
  719.      blinkkey(graphics, key, blinkrow, blinkcol );   { blinking the pressed key}
  720.      case key of
  721.       qpalette : begin
  722.         palettenum := getint('palettenum (0:G/R/Y 1:C/M/W)');
  723.         bcolor:= getint('background color (0..31)');
  724.         palette(palettenum, bcolor);
  725.           end;
  726.  
  727.       qwritedot : begin
  728.         x := askx;
  729.         y := getint('y coordinate (0..199)');
  730.         fcolor := askcolor;
  731.         writedot(x, y, fcolor );
  732.           end;
  733.  
  734.       qreaddot : begin
  735.         x := askx;
  736.         y := getint('y coordinate (0..199)');
  737.         fcolor := readdot(x,y);
  738.         locate(currentpage, inforow, msgcol );
  739.         writeln('color=',fcolor:3);
  740.           end;
  741.  
  742.       qdrawline : begin
  743.         if currentmode = 6 then  begin
  744.            x := getint('x1 (0..639)') ;
  745.            y := getint('y1 (0..199)');
  746.            x2 := getint('x2 (0..639)')
  747.         end
  748.         else  begin
  749.            x := getint('x1 (0..319)');
  750.            y := getint('y1 (0..199)');
  751.            x2 := getint('x2 (0..319)')
  752.         end;
  753.         y2  := getint('y2 (0..199)');
  754.         fcolor := askcolor;
  755.         drawline(x,y,X2,Y2,fcolor);
  756.           end;
  757.  
  758.       qgetpic : begin
  759.         if currentmode = 6 then begin
  760.            x  := getint('left x (0..639)');
  761.            y  := getint('lower y (0..199)');
  762.            x2 := getint('right x (0..639)');
  763.            i  :=abs( (x2+7)div 8-(x+7)div 8);    {width of the picture}
  764.         end                     { in bytes }
  765.         else begin
  766.            x  := getint('left x (0..319)');
  767.            y  := getint('lower y (0..199)');
  768.            x2 := getint('right x (0..319)');
  769.            i  :=abs ((x2+3)div 4  - (x2+3)div 4 );
  770.         end;
  771.         y2:= getint('upper y (0..199)');
  772.         i := i*(abs(y2-y)+1)+2;     { total numbe of bytes }
  773.         if i > picsize then begin
  774.           lstringwrite(currentpage, msgrow, msgcol, normal,
  775.             'picture size > the declared size (1024)');
  776.           pressreturn;
  777.         end
  778.         else
  779.           getpic(x,y,X2,Y2,pic);
  780.           end;
  781.  
  782.       qputpic : begin
  783.         x := askx;
  784.         y := getint('lower y (0..199)');
  785.         lstringwrite(currentpage, inforow, msgcol, normal,
  786.                    '0:XOR; 1:PSET; -1:NEG; 2:OR; 3:AND ');
  787.         action := getint('action(0..3)');
  788.         putpic(x,y,action, pic);
  789.         lstringwrite(currentpage, inforow, msgcol, normal,
  790.             blanks);
  791.           end;
  792.  
  793.       qcircle : begin
  794.         if currentmode = 6 then
  795.            x := getint('center x (0..639)')
  796.         else
  797.            x := getint('center x (0..319)');
  798.         y := getint('center y');
  799.         width  := getint('width');
  800.         height := getint('height');
  801.         fcolor := askcolor;
  802.         sangle := getint('starting angle');
  803.         eangle := getint('ending angle');
  804.         circle(x,y,width,height,fcolor,sangle,eangle);
  805.           end;
  806.  
  807.       qpaint: begin
  808.         x := askx;
  809.         y := getint('y (0..199)');
  810.         fcolor := getint('interior color');
  811.         bcolor := getint('boundary color');
  812.         i  := getint('pattern');
  813.         paint(x,y,fcolor,bcolor,i);
  814.           end;
  815.  
  816.       qview : begin
  817.         if currentmode = 6 then  begin
  818.            x := getint('left x (0..639)') ;
  819.            y := getint('bottom y (0..199)');
  820.            x2 := getint('right x (0..639)')
  821.         end
  822.         else  begin
  823.            x := getint('left x (0..319)');
  824.            y := getint('bottom y (0..199)');
  825.            x2 := getint('right x (0..319)')
  826.         end;
  827.         y2  := getint('top y (0..199)');
  828.         view(x,y,X2,Y2);
  829.           end;
  830.  
  831.       qlightpen : begin
  832.         lstringwrite(currentpage, msgrow, msgcol,normal,
  833.                'Use Lightpen then Press any key');
  834.         while not inkey( lastch, lastscan ) do{ while no key is pressed}
  835.           if lightpen(row, col, x, y) then begin
  836.              locate(currentpage, inforow, msgcol);
  837.              writeln('LIGHTPEN=TRUE', ' row=',row:1, ' col=', col:1,
  838.                 ' x=',x:1, ' y=',y:1);
  839.           end
  840.           else begin
  841.              locate(currentpage, inforow, msgcol);
  842.              writeln('LIGHTPEN=FALSE');
  843.           end;
  844.         displaych;
  845.           end;
  846.  
  847.       otherwise  { do nothing }
  848.       end;    { case end }
  849.      messageuse;
  850.      lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
  851.      , graphics[key]);    { reset the blinking function key to reverse }
  852.      end  { if scan < }
  853.     else
  854.       cursormoves( lastscan );
  855.    until false;
  856. end; { graphicsroutines }
  857.  
  858.  
  859.  
  860.  
  861. {***** peripheralroutines - handle peripheral routines }
  862. procedure peripheralroutines;
  863. const
  864.   qrandomize = 1;    qnumequip =2;
  865.   qrnd =       3;    qprinter  =4;
  866.   qsound =     5;    qexit     =10;
  867. var
  868.   blinkcol, blinkrow, seed, random, i, key : integer;
  869.   peripheral[static] : softkeytype; ch : char;
  870.   freq[static] : array[1 .. 7 ] of integer;
  871.  
  872. value
  873.   peripheral[qrandomize]:='RANDOMIZE '; peripheral[qnumequip]:='NUMEQUIP  ';
  874.   peripheral[qrnd      ]:='RND       '; peripheral[qprinter ]:='PRINTER   ';
  875.   peripheral[         5 ]:='SOUND     '; peripheral[       6 ]:='          ';
  876.   peripheral[         7 ]:='          '; peripheral[       8 ]:='          ';
  877.   peripheral[         9 ]:='          '; peripheral[   qexit ]:='EXIT      ';
  878.  
  879.   freq[1]:=523; freq[2]:=587; freq[3]:=659; freq[4]:=698;
  880.   freq[5]:=784; freq[6]:=880; freq[7]:=988;
  881. begin
  882.   newdisplay( peripheral );    { display softkeys }
  883.   messageuse;
  884.   repeat
  885.    while not inkey( lastch, lastscan ) do
  886.      displaytime;
  887.    if (lastscan = 0 ) and ( lastch = chr(0) ) then break;
  888.    if lastscan = qesc then break;        { out of the repeat loop }
  889.    if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
  890.      key := lastscan - scanf0;
  891.      blankmessage;
  892.      blinkkey(peripheral, key, blinkrow, blinkcol );   { blinking the pressed key}
  893.      case key of
  894.       qrandomize : begin
  895.         seed := getint('seed (0..65535)');
  896.         randomize(seed);
  897.           end;
  898.  
  899.       qrnd : begin
  900.         lstringwrite(currentpage, 13, 0, normal,
  901.           'random numbers between 0 and 65535:');
  902.         locate(currentpage, 14,0);
  903.         for i := 1 to 5 do
  904.           write( rnd:7);
  905.  
  906.         lstringwrite(currentpage, 16, 0, normal,
  907.           'random numbers between -32768 and 32767:');
  908.         locate(currentpage, 17,0);
  909.         for i := 1 to 5 do begin
  910.           random := rnd;          { random is an integer }
  911.           write( random:7);
  912.         end;
  913.  
  914.         lstringwrite(currentpage, 19, 0, normal,
  915.           'random numbers between 1 and 6(for dice):');
  916.         locate(currentpage, 20,0);
  917.         for i := 1 to 19 do  begin
  918.           random := rnd mod 6 + 1;
  919.           write( random:2 );
  920.         end;
  921.          end; {qrnd}
  922.  
  923.       qnumequip :begin    {find all the equipments }
  924.         locate(currentpage,13,0);
  925.         writeln('NUMDISK   =',numdisk:5,  '  NUMPRAM   =',numpram:5);
  926.         locate(currentpage,15,0);
  927.         writeln('NUMGAME   =',numgame:5,  '  NUMCOMM   =',numcomm:5);
  928.         locate(currentpage,17,0);
  929.         writeln('NUMMEMORY =',nummemory:5,'  NUMPRINTER=',numprinter:5);
  930.         end;
  931.  
  932.      qprinter : begin
  933.         prtinit(0);
  934.         if prtstatus(0) =  0 then begin
  935.           regular(0);
  936.           prtlstring(0,'regular');
  937.           compress(0);
  938.           prtlstring(0,'compress');
  939.           regular(0);    dblwidth(0);
  940.           prtlstring(0,'dblwidth');
  941.           regular(0);    emphasize(0);
  942.           prtlstring(0,'emphasize');
  943.           regular(0);    dblstrike(0);
  944.           prtlstring(0,'dblstrike');
  945.           regular(0);
  946.         end
  947.         else begin
  948.           locate(currentpage, inforow, msgcol);
  949.           writeln(' PRTSTATUS=', prtstatus(0));
  950.         end;
  951.           end;
  952.  
  953.       qsound :begin
  954.         for i := 1 to 7 do
  955.           sound( freq[i], 50); { half second for each note }
  956.         sound(0, 100);           {waiting for one second }
  957.         for I := 7 downto 1 do
  958.           sound( freq[i], 100);{ 1 second for each note}
  959.           end;
  960.  
  961.       qexit : break;
  962.  
  963.       otherwise  { do nothing }
  964.       end;    { case end }
  965.      messageuse;
  966.      lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
  967.      ,peripheral[key]);     { reset the blinking function key to reverse }
  968.      end  { if scan < }
  969.     else
  970.       cursormoves( lastscan );
  971.    until false;
  972. end; { peripheralroutines }
  973.  
  974.  
  975.  
  976.  
  977. {***** mainmunu - the main menu }
  978. procedure mainmenu;
  979. const
  980.   { topmenu keys }
  981.   qdemos     = 1;     qgraphics   = 2;
  982.   qdemosall  = 3;     qperipheral = 4;
  983.   qdemog     = 5;     qscreen1    = 6;
  984.   qfastscroll= 7;     qscreen2    = 8;
  985.   qslowscroll= 9;     qexit         = 10;
  986.  
  987.   lastmsg   = 15;     lastmsgp1 = lastmsg+1;
  988.   brow       = 21; trow = 12;  { bottom and top row number for the scrooling
  989.                 message window }
  990.   delayinc = 100;
  991.  
  992. var
  993.   topmenu[static] : softkeytype;
  994.   nextmsg, key: integer;
  995.   msg[static] : array[0..lastmsg] of lstring(40);
  996.   delay : integer;         { delay count for displaying }
  997.   count : integer;         { when count >= delay then display a new message}
  998.  
  999. value
  1000.   topmenu[ qdemos     ] := 'DEMOS     ';  topmenu[ qgraphics  ] := 'GRAPHICS  ';
  1001.   topmenu[ qdemosall  ] := 'DEMOSALL  ';  topmenu[ qperipheral] := 'PERIPHERAL';
  1002.   topmenu[ qdemog     ] := 'DEMOG     ';  topmenu[ qscreen1   ] := 'SCREEN1   ';
  1003.   topmenu[ qfastscroll] := 'FastScroll';  topmenu[ qscreen2   ] := 'SCREEN2   ';
  1004.   topmenu[ qslowscroll] := 'SlowScroll';  topmenu[ qexit      ] := 'EXIT      ';
  1005.   msg[0] := 'Press F1, F2,...F9, F10 to select the   ';
  1006.   msg[1] := ' corresponding command  e.g. F1=DEMOS.  ';
  1007.   msg[2] := 'Press ESC to exit this command level.   ';
  1008.   msg[3] := blanks;
  1009.   msg[4] := 'DEMOS     -screen text color table demo.';
  1010.   msg[5] := 'DEMOSALL  -all text  color  tables demo.';
  1011.   msg[6] := 'DEMOG     -graphics,  animation,  music.';
  1012.   msg[7] := 'FastScroll-Scroll these messages faster.';
  1013.   msg[8] := 'SlowScroll-Scroll these messages slower.';
  1014.   msg[9] := blanks;
  1015.   msg[10]:= 'GRAPHICS  -Enters the  GRAPHICS  Driver.';
  1016.   msg[11]:= 'PERIPHERAL-Enters the PERIPHERAL Driver.';
  1017.   msg[12]:= 'SCREEN1   -Enters the SCREEN1    Driver.';
  1018.   msg[13]:= 'SCREEN2   -Enters the SCREEN2    Driver.';
  1019.   msg[14]:= ' You may test each routine in a  Driver.';
  1020.   msg[15]:= blanks;
  1021.  
  1022. begin
  1023.   newdisplay( topmenu );         { display function keys }
  1024.   lstringwrite(currentpage, 0, 8, normal, ' PASCAL Utilities by SoftwareLab');
  1025.   messageuse;                 { use function key }
  1026.   nextmsg := lastmsg;
  1027.   delay := initialdelay;          {initial delay elapse period }
  1028.   count := delay;
  1029.   repeat                 { until ESC or EXIT is pressed }
  1030.     while not inkey( lastch, lastscan) do { while no key is pressed update time}
  1031.     begin                  { and display messages }
  1032.       displaytime;
  1033.       { increment count until it is greater than delay then display a line }
  1034.       if count >= delay then begin
  1035.     count := 0;
  1036.     { rotating using the message }
  1037.     if nextmsg >= lastmsg then        { rotate the displaying message }
  1038.       nextmsg := 0
  1039.     else
  1040.       nextmsg := nextmsg + 1;
  1041.     scroll('U', 1, trow, 0, brow, 39, normal);     { scroll the message }
  1042.     lstringwrite(currentpage, brow, 0, normal, msg[nextmsg]); {new message}
  1043.       end    { count >= delay }
  1044.       else
  1045.     count := count +1;
  1046.     end; { end of while waiting for inkey }
  1047.     if (lastscan = 0 ) and ( lastch = chr(0) ) then break;
  1048.     if lastscan = qesc then break;     { out of the repeat loop for ESC pressed}
  1049.     if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
  1050.       key := lastscan -scanf0;
  1051.       if key = qfastscroll then
  1052.     delay := delay - delayinc
  1053.       else
  1054.     if key = qslowscroll then
  1055.       delay := delay + delayinc
  1056.     else begin    { regular routines }
  1057.       blankmessage;
  1058.       scroll('u', 0, trow, 0, brow, 39, normal); {scroll the entire window}
  1059.       scroll('u', 1, 0, 0, 23, 79, normal);      {reset the scroll window}
  1060.       case key of
  1061.        qscreen1  :    screen1routines;
  1062.        qscreen2  :    screen2routines;
  1063.        qgraphics :    graphicsroutines;
  1064.        qdemos    :    demos;
  1065.        qdemosall :    demosall( delay );
  1066.        qdemog    :    demog;
  1067.        qperipheral: peripheralroutines;
  1068.        qexit     :    break;
  1069.        otherwise  { do nothing }
  1070.       end; { case }
  1071.       newdisplay( topmenu );
  1072.       nextmsg := lastmsg;
  1073.       messageuse;                 { use function key }
  1074.     end;  { key <> qfaster and key <> qslower }
  1075.       end             { if scan > scanf > scanf0 and scan <= scanf10 }
  1076.     else
  1077.       cursormoves( lastscan );
  1078.   until false;               { break for ESC or exit }
  1079.   screen(currentmode);
  1080. end; { mainmenu }
  1081.  
  1082.  
  1083.  
  1084.  
  1085. {***** initialize - initialize global variables }
  1086. procedure initialize;
  1087. begin
  1088.  currentmode := screenmode( currentpage, currentcol );
  1089.  if currentmode = 7 then    { Monochrome Display Adapter returns 7 }
  1090.     screen(currentmode)
  1091.  else
  1092.     screen(4);        {40x25 color mode }
  1093.  currentmode := screenmode( currentpage, currentcol );
  1094.  if currentmode = 7 then currentpage := 0;
  1095.  readcursor(currentpage, currentrow, currentcol, currentstart, currentstop);
  1096.  currentcol := homecol;  currentrow := homerow;    { set the cursor position}
  1097.  end; { initialize }
  1098.  
  1099. {***** logo - print ordering message}
  1100. procedure logo;
  1101. begin
  1102.   lstringwrite(0, 0, 0, normal,   'This is a  demo program  for the  Pascal');
  1103.   lstringwrite(0, 1, 0, normal,   'Utilities Package which consists of over');
  1104.   lstringwrite(0, 2, 0, normal,   'seventy assembly language routines to be');
  1105.   lstringwrite(0, 3, 0, normal,   'called from  IBM PC DOS Pascal programs.');
  1106.   lstringwrite(0, 4, 0, normal,   'The routines control');
  1107.   lstringwrite(0, 4,22,intensity, 'screen,  keyboard,');
  1108.   lstringwrite(0, 5, 0,intensity, 'graphics, joyticks, light pen, printers,');
  1109.   lstringwrite(0, 6, 0,intensity, 'music, and communication ports.');
  1110.   lstringwrite(0, 7, 0, normal,   'The file  "mini.obj"  on this  demo disk');
  1111.   lstringwrite(0, 8, 0, normal,   'contains only  several routines from the');
  1112.   lstringwrite(0, 9, 0, normal,   'Pascal Utilities package.   Price of the');
  1113.   lstringwrite(0,10, 0, normal,   'complete  package  including a  110 page');
  1114.   lstringwrite(0,11, 0, normal,   'manual is  $119.00.');
  1115.   lstringwrite(0,12, 0, normal,   'To order it, please send a check or give');
  1116.   lstringwrite(0,13, 0, normal,   'VISA/MC number and expiration date to:');
  1117.   lstringwrite(0,15,10,intensity, 'Software Labs');
  1118.   lstringwrite(0,16,10,intensity, '1052 Lily Ave.');
  1119.   lstringwrite(0,17,10,intensity, 'Sunnyvale, CA 94086');
  1120.   lstringwrite(0,18,10,intensity, '(408)-241-9539');
  1121.   lstringwrite(0,20, 0, normal,   'Similar  utilities packages for  Fortran');
  1122.   lstringwrite(0,21, 0, normal,   'and Lattice C are available  at $119.00.');
  1123.   pressreturn;
  1124. end; {logo}
  1125.  
  1126. begin { main program }
  1127.   initialize;            {initilize screen variables }
  1128.   logo;             { message}
  1129.   mainmenu;            { execute the main menu }
  1130.   end.                { main }
  1131.